home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / cursors.zip / CURSORS.PAS
Pascal/Delphi Source File  |  1985-12-07  |  4KB  |  119 lines
  1. PROGRAM CURSORS;
  2.  
  3. {   This program is a sample on how to control the cursor using TURBO PASCAL
  4.     on an IBM or IBM compatable machine.  It calls the BIOS VIDEO_IO module
  5.     through the standard interupt $10.  This will not work with any machine
  6.     not supporting the standard interupts into the BIOS roms               }
  7.  
  8. VAR
  9.     X         :   STRING[79];
  10.     StartScan :   INTEGER;
  11.     EndScan   :   INTEGER;
  12.  
  13. {--------------------------------------------------------------------------}
  14. PROCEDURE SetCursor (StartLine,EndLine : Integer);
  15.       { This procedure does the actual cursor setting thru the TURBO
  16.         INTR procedure.                                              }
  17.  TYPE
  18.       Register = record
  19.                  ax,bx,cx,dx,bp,si,ds,es,flags : integer;
  20.                  end;
  21.  VAR
  22.       IntrRegs    :  Register;
  23.       CXRegArray  :  Array [1..2] of Byte;
  24.       CXReg       :  integer absolute CXRegArray;
  25.  BEGIN
  26.       CXRegArray[2] := LO(StartLine);
  27.       CXRegArray[1] := LO(EndLine);
  28.       With IntrRegs do
  29.            BEGIN
  30.            ax := $0100;             {ah = 1 means set cursor type}
  31.            bx := $0;                {bx = page number, zero for us}
  32.            cx := CXReg;             {ch bits 4 to 0 = start line for cursor}
  33.                                     {cl bits 4 to 0 = end line for cursor}
  34.            intr($10,IntrRegs);      {set cursor}
  35.       END;
  36.  
  37. END;
  38.  
  39. {--------------------------------------------------------------------------}
  40. PROCEDURE NoCursor;
  41.       { This procedure calls SetCursor to turn the cursor off }
  42. BEGIN
  43.       SetCursor(32,0);              {Setting bit 5 turns off cursor}
  44. END;
  45.  
  46. {--------------------------------------------------------------------------}
  47. PROCEDURE BoxCursor;
  48.       { This procedure calls SetCursor to show a block (box) cursor }
  49. BEGIN
  50.       SetCursor(0,13);              {0-7 for mono, 0-13 for color}
  51.                                     {but 0-13 works ok for mono too}
  52. END;
  53. {--------------------------------------------------------------------------}
  54. FUNCTION CrtMode : Integer;
  55.        { This procedure call BIOS to determine current CRT mode }
  56. TYPE
  57.       Register = record
  58.                  ax,bx,cx,dx,bp,si,ds,es,flags : integer;
  59.                  end;
  60. VAR
  61.       IntrRegs    :  Register;
  62. BEGIN
  63.      With IntrRegs do
  64.        BEGIN
  65.        ax := $0F00;                   {VIDEO_IO function 15}
  66.        Intr($10,IntrRegs);
  67.        CrtMode := LO(ax);
  68.        END;
  69. END;
  70.  
  71. {--------------------------------------------------------------------------}
  72. PROCEDURE NormCursor;
  73.       { This procedure calls SetCursor to show the 'normal' cursor }
  74. BEGIN
  75.       If CrtMode = 7 then
  76.          SetCursor(11,12)              {mono}
  77.       else
  78.          SetCursor(6,7);               {color}
  79. END;
  80.  
  81. {--------------------------------------------------------------------------}
  82. BEGIN     {Main Program}
  83.  
  84.      ClrScr;            {Clear Screen}
  85.  
  86.      GoToXY(1,5);       {Row 5, Column 1}
  87.      WriteLn('Notice that there is now NO cursor! (Press Enter to continue)');
  88.      NoCursor;
  89.      ReadLn(X);
  90.  
  91.      GoToXY(1,7);
  92.      WriteLn('Now notice the BOX cursor! (Press Enter to continue)');
  93.      BoxCursor;
  94.      ReadLn(X);
  95.  
  96.      GoToXY(1,9);
  97.      WriteLn('Now back to the normal cursor! (Press Enter to continue)');
  98.      NormCursor;
  99.      ReadLn(X);
  100.  
  101.      StartScan := 1;   EndScan := 1;
  102.      While (StartScan > 0) or (EndScan > 0) do
  103.         BEGIN
  104.         GoToXY(1,12);
  105.         WriteLn('Now it is time to design your own (enter zero for both to end)');
  106.         Write('Enter the topmost scan line for the cursor (0-13):');
  107.         ReadLn(StartScan);
  108.         Write('Enter the bottom scan line for the cursor (0-13):');
  109.         ReadLn(EndScan);
  110.         If (StartScan > 0) or (EndScan > 0) then
  111.            BEGIN
  112.            SetCursor(StartScan,EndScan);
  113.            GoToXY(1,15);
  114.            WriteLn('Well, here is your cursor:');
  115.            ReadLn(X);
  116.            END;
  117.         END;
  118.         NormCursor;
  119. END.